home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / sptmbr11.lha / clx / defsystem.lisp < prev    next >
Text File  |  1992-06-08  |  18KB  |  521 lines
  1. ;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Lowercase: T;  -*-
  2.  
  3. ;;;
  4. ;;;             TEXAS INSTRUMENTS INCORPORATED
  5. ;;;                  P.O. BOX 2909
  6. ;;;                   AUSTIN, TEXAS 78769
  7. ;;;
  8. ;;; Portions Copyright (C) 1987 Texas Instruments Incorporated.
  9. ;;; Portions Copyright (C) 1988, 1989 Franz Inc, Berkeley, Ca.
  10. ;;;
  11. ;;; Permission is granted to any individual or institution to use, copy, modify,
  12. ;;; and distribute this software, provided that this complete copyright and
  13. ;;; permission notice is maintained, intact, in all copies and supporting
  14. ;;; documentation.
  15. ;;;
  16. ;;; Texas Instruments Incorporated provides this software "as is" without
  17. ;;; express or implied warranty.
  18. ;;;
  19. ;;; Franz Incorporated provides this software "as is" without express or
  20. ;;; implied warranty.
  21.  
  22. ;;; #+ features used in this file
  23. ;;;   clx-ansi-common-lisp
  24. ;;;   lispm
  25. ;;;   genera
  26. ;;;   minima
  27. ;;;   lucid
  28. ;;;   lcl3.0
  29. ;;;   apollo
  30. ;;;   kcl
  31. ;;;   ibcl
  32. ;;;   excl
  33. ;;;   CMU
  34.  
  35. #+(or Genera Minima)
  36. (eval-when (:compile-toplevel :load-toplevel :execute)
  37.   (common-lisp:pushnew :clx-ansi-common-lisp common-lisp:*features*))
  38.  
  39. #+(and Genera clx-ansi-common-lisp)
  40. (eval-when (:compile-toplevel :load-toplevel :execute)
  41.   (setf *readtable* si:*ansi-common-lisp-readtable*))
  42.  
  43. #-clx-ansi-common-lisp 
  44. (lisp:in-package :user)
  45.  
  46. #+clx-ansi-common-lisp
  47. (common-lisp:in-package :common-lisp-user)
  48.  
  49.  
  50. ;;;; Lisp Machines
  51.  
  52. #+(and lispm (not genera))
  53. (global:defsystem CLX
  54.   (:pathname-default "clx:clx;")
  55.   (:patchable "clx:patch;" clx-ti)
  56.   (:initial-status :experimental)
  57.  
  58.   (:module package "package")
  59.   (:module depdefs "depdefs")
  60.   (:module clx "clx")
  61.   (:module dependent "dependent")
  62.   (:module macros "macros")
  63.   (:module bufmac "bufmac")
  64.   (:module buffer "buffer")
  65.   (:module display "display")
  66.   (:module gcontext "gcontext")
  67.   (:module requests "requests")
  68.   (:module input "input")
  69.   (:module fonts "fonts")
  70.   (:module graphics "graphics")
  71.   (:module text "text")
  72.   (:module attributes "attributes")
  73.   (:module translate "translate")
  74.   (:module keysyms "keysyms")
  75.   (:module manager "manager")
  76.   (:module image "image")
  77.   (:module resource "resource")
  78.   (:module doc "doc")
  79.  
  80.   (:compile-load package)
  81.   (:compile-load depdefs
  82.    (:fasload package))
  83.   (:compile-load clx
  84.    (:fasload package depdefs))
  85.   (:compile-load dependent
  86.    (:fasload package depdefs clx))
  87.   ;; Macros only needed for compilation
  88.   (:skip :compile-load macros
  89.    (:fasload package depdefs clx dependent))
  90.   ;; Bufmac only needed for compilation
  91.   (:skip :compile-load bufmac
  92.    (:fasload package depdefs clx dependent macros))
  93.   (:compile-load buffer
  94.    (:fasload package depdefs clx dependent macros bufmac))
  95.   (:compile-load display
  96.    (:fasload package depdefs clx dependent macros bufmac buffer))
  97.   (:compile-load gcontext
  98.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  99.   (:compile-load input
  100.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  101.   (:compile-load requests
  102.    (:fasload package depdefs clx dependent macros bufmac buffer display input))
  103.   (:compile-load fonts
  104.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  105.   (:compile-load graphics
  106.    (:fasload package depdefs clx dependent macros fonts bufmac buffer display
  107.          fonts))
  108.   (:compile-load text
  109.    (:fasload package depdefs clx dependent macros fonts bufmac buffer display
  110.          gcontext fonts))
  111.   (:compile-load-init attributes
  112.    (dependent)
  113.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  114.   (:compile-load translate
  115.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  116.   (:compile-load keysyms
  117.    (:fasload package depdefs clx dependent macros bufmac buffer display
  118.          translate))
  119.   (:compile-load manager
  120.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  121.   (:compile-load image
  122.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  123.   (:compile-load resource
  124.    (:fasload package depdefs clx dependent macros bufmac buffer display))
  125.   (:auxiliary doc)
  126.   )
  127.  
  128.  
  129. ;;; Symbolics Lisp Machines
  130. #+Genera
  131. (scl:defsystem CLX
  132.     (:default-pathname "SYS:X11;CLX;"
  133.      :pretty-name "CLX"
  134.      :maintaining-sites (:scrc)
  135.      :distribute-sources t
  136.      :distribute-binaries t
  137.      :source-category :basic)
  138.   (:module doc ("doc")
  139.        (:type :lisp-example))
  140.   (:serial
  141.     "package" "depdefs" "generalock" "clx" "dependent" "macros" "bufmac"
  142.     "buffer" "display" "gcontext" "input" "requests" "fonts" "graphics"
  143.     "text" "attributes" "translate" "keysyms" "manager" "image" "resource"))
  144.  
  145.  
  146. ;;; Franz
  147.  
  148. ;;
  149. ;; The following is a suggestion.  If you comment out this form be
  150. ;; prepared for possible deadlock, since no interrupts will be recognized
  151. ;; while reading from the X socket if the scheduler is not running.
  152. ;;
  153. #+excl
  154. (setq compiler::generate-interrupt-checks-switch
  155.       (compile nil
  156.            '(lambda (safety size speed &optional debug)
  157.           (declare (ignore size debug))
  158.           (or (< speed 3) (> safety 0)))))
  159.  
  160.  
  161. ;;; Allegro
  162.  
  163. #+allegro
  164. (excl:defsystem :clx 
  165.   ()
  166.   |package|
  167.   (|excldep|
  168.     :load-before-compile (|package|)
  169.     :recompile-on (|package|))
  170.   (|depdefs|
  171.     :load-before-compile (|package| |excldep|)
  172.     :recompile-on (|excldep|))
  173.   (|clx|
  174.     :load-before-compile (|package| |excldep| |depdefs|)
  175.     :recompile-on (|package| |excldep| |depdefs|))
  176.   (|dependent|
  177.     :load-before-compile (|package| |excldep| |depdefs| |clx|)
  178.     :recompile-on (|clx|))
  179.   (|exclcmac|
  180.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|)
  181.     :recompile-on (|dependent|))
  182.   (|macros|
  183.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  184.               |exclcmac|)
  185.     :recompile-on (|exclcmac|))
  186.   (|bufmac|
  187.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  188.               |exclcmac| |macros|)
  189.     :recompile-on (|macros|))
  190.   (|buffer|
  191.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  192.               |exclcmac| |macros| |bufmac|)
  193.     :recompile-on (|bufmac|))
  194.   (|display|
  195.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  196.               |exclcmac| |macros| |bufmac| |buffer|)
  197.     :recompile-on (|buffer|))
  198.   (|gcontext|
  199.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  200.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  201.     :recompile-on (|display|))
  202.   (|input|
  203.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  204.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  205.     :recompile-on (|display|))
  206.   (|requests|
  207.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  208.               |exclcmac| |macros| |bufmac| |buffer| |display|
  209.               |input|)
  210.     :recompile-on (|display|))
  211.   (|fonts|
  212.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  213.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  214.     :recompile-on (|display|))
  215.   (|graphics|
  216.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  217.               |exclcmac| |macros| |bufmac| |buffer| |display|
  218.               |fonts|)
  219.     :recompile-on (|fonts|))
  220.   (|text|
  221.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  222.               |exclcmac| |macros| |bufmac| |buffer| |display|
  223.               |gcontext| |fonts|)
  224.     :recompile-on (|gcontext| |fonts|)
  225.     :load-after (|translate|))
  226.   ;; The above line gets around a compiler macro expansion bug.
  227.   
  228.   (|attributes|
  229.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  230.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  231.     :recompile-on (|display|))
  232.   (|translate|
  233.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  234.               |exclcmac| |macros| |bufmac| |buffer| |display|
  235.               |text|)
  236.     :recompile-on (|display|))
  237.   (|keysyms|
  238.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  239.               |exclcmac| |macros| |bufmac| |buffer| |display|
  240.               |translate|)
  241.     :recompile-on (|translate|))
  242.   (|manager|
  243.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  244.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  245.     :recompile-on (|display|))
  246.   (|image|
  247.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  248.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  249.     :recompile-on (|display|))
  250.   
  251.   ;; Don't know if l-b-c list is correct.  XX
  252.   (|resource|
  253.     :load-before-compile (|package| |excldep| |depdefs| |clx| |dependent|
  254.               |exclcmac| |macros| |bufmac| |buffer| |display|)
  255.     :recompile-on (|display|))
  256.   )
  257.  
  258. #+allegro
  259. (excl:defsystem :clx-debug
  260.     (:default-pathname "debug/"
  261.      :needed-systems (:clx)
  262.      :load-before-compile (:clx))
  263.   |describe| |keytrans| |trace| |util|)
  264.  
  265.  
  266. ;;;; Compile CLX
  267.  
  268. ;;; COMPILE-CLX compiles the lisp source files and loads the binaries.
  269. ;;; It goes to some trouble to let the source files be in one directory
  270. ;;; and the binary files in another.  Thus the same set of sources can
  271. ;;; be used for different machines and/or lisp systems.  It also allows
  272. ;;; you to supply explicit extensions, so source files do not have to
  273. ;;; be renamed to fit into the naming conventions of an implementation.
  274.  
  275. ;;; For example,
  276. ;;;     (compile-clx "*.lisp" "machine/")
  277. ;;; compiles source files from the connected directory and puts them
  278. ;;; into the "machine" subdirectory.  You can then load CLX out of the
  279. ;;; machine directory.
  280.  
  281. ;;; The code has no knowledge of the source file types (eg, ".l" or
  282. ;;; ".lisp") or of the binary file types (eg, ".b" or ".sbin").  Calling
  283. ;;; compile-file and load with a file type of NIL usually sorts things
  284. ;;; out correctly, but you may have to explicitly give the source and
  285. ;;; binary file types.
  286.  
  287. ;;; An attempt at compiling the C language sources is also made,
  288. ;;; but you may have to set different compiler switches
  289. ;;; should be.  If it doesn't do the right thing, then do
  290. ;;;     (compile-clx "" "" :compile-c NIL)
  291. ;;; to prevent the compilation.
  292.  
  293. ;;; compilation notes
  294. ;;;   lucid2.0/hp9000s300
  295. ;;;     must uudecode the file make-sequence-patch.uu
  296.  
  297. #+(or lucid kcl ibcl)
  298. (defun clx-foreign-files (binary-path)
  299.  
  300.   #+(and lucid (not lcl3.0) (or mc68000 mc68020))
  301.   (load (merge-pathnames "make-sequence-patch" binary-path))
  302.  
  303.   #+(and lucid apollo)
  304.   (lucid::load-foreign-file
  305.     (namestring (merge-pathnames "socket" binary-path))
  306.     :preserve-pathname t)
  307.  
  308.   #+(and lucid (not apollo))
  309.   (lucid::load-foreign-files
  310.     (list (namestring (merge-pathnames "socket.o" binary-path)))
  311.     '("-lc"))
  312.  
  313.   #+(or kcl ibcl)
  314.   (progn
  315.     (let ((pathname (merge-pathnames "sockcl.o" binary-path))
  316.       (options
  317.         (concatenate
  318.           'string
  319.           (namestring (merge-pathnames "socket.o" binary-path))
  320.           " -lc")))
  321.       (format t "~&Faslinking ~A with ~A.~%" pathname options)
  322.       (si:faslink (namestring pathname) options)
  323.       (format t "~&Finished faslinking ~A.~%" pathname)))
  324.   )
  325.  
  326. #-(or lispm allegro)
  327. (defun compile-clx (&optional
  328.             (source-pathname-defaults "")
  329.             (binary-pathname-defaults "")
  330.             &key
  331.             (compile-c t))
  332.  
  333.   ;; The pathname-defaults above might only be strings, so coerce them
  334.   ;; to pathnames.  Build a default binary path with every component
  335.   ;; of the source except the file type.  This should prevent
  336.   ;; (compile-clx "*.lisp") from destroying source files.
  337.   (let* ((source-path (pathname source-pathname-defaults))
  338.      (path        (make-pathname
  339.             :host      (pathname-host      source-path)
  340.             :device    (pathname-device    source-path)
  341.             :directory (pathname-directory source-path)
  342.             :name      (pathname-name      source-path)
  343.             :type      nil
  344.             :version   (pathname-version   source-path)))
  345.      (binary-path (merge-pathnames binary-pathname-defaults
  346.                        path))
  347.      #+clx-ansi-common-lisp (*compile-verbose* t)
  348.      (*load-verbose* t))
  349.                        
  350.     ;; Make sure source-path and binary-path file types are distinct so
  351.     ;; we don't accidently overwrite the source files.  NIL should be an
  352.     ;; ok type, but anything else spells trouble.
  353.     (if (and (equal (pathname-type source-path)
  354.             (pathname-type binary-path))
  355.          (not (null (pathname-type binary-path))))
  356.     (error "Source and binary pathname defaults have same type ~s ~s"
  357.            source-path binary-path))
  358.  
  359.     (format t "~&;;; Default paths: ~s ~s~%" source-path binary-path)
  360.  
  361.     ;; In lucid make sure we're using the compiler in production mode.
  362.     #+lcl3.0
  363.     (progn
  364.       (unless (member :pqc *features*)
  365.     (cerror
  366.       "Go ahead anyway."
  367.       "Lucid's production mode compiler must be loaded to compile CLX."))
  368.       (proclaim '(optimize (speed 3)
  369.                (safety 1)
  370.                (space 0)
  371.                (compilation-speed 0))))
  372.  
  373.     (labels ((compile-lisp (filename)
  374.            (let ((source (merge-pathnames filename source-path))
  375.              (binary (merge-pathnames filename binary-path)))
  376.          ;; If the source and binary pathnames are the same,
  377.          ;; then don't supply an output file just to be sure
  378.          ;; compile-file defaults correctly.
  379.          #+(or kcl ibcl) (load source)
  380.          (if (equal source binary)
  381.              (compile-file source)
  382.            (compile-file source :output-file binary  
  383.                  #+CMU :error-file #+CMU nil))
  384.          binary))
  385.          (compile-and-load (filename)
  386.            (load (compile-lisp filename)))
  387.          #+(or lucid kcl ibcl)
  388.          (compile-c (filename)
  389.            (let* ((c-filename (concatenate 'string filename ".c"))
  390.               (o-filename (concatenate 'string filename ".o"))
  391.               (src (merge-pathnames c-filename source-path))
  392.               (obj  (merge-pathnames o-filename binary-path))
  393.               (args (list "-c" (namestring src)
  394.                   "-o" (namestring obj)
  395.                   #+mips "-G 0"
  396.                   #+(or hp sysv) "-DSYSV"
  397.                   #+(and mips (not dec)) "-I/usr/include/bsd"
  398.                   #-(and mips (not dec)) "-DUNIXCONN"
  399.                   #+(and lucid pa) "-DHPUX -DHPUX7.0"
  400.                   )))
  401.          (format t ";;; cc~{ ~A~}~%" args)
  402.          (unless
  403.            (zerop 
  404.              #+lucid
  405.              (multiple-value-bind (iostream estream exitstatus pid)
  406.              ;; in 2.0, run-program is exported from system:
  407.              ;; in 3.0, run-program is exported from lcl:
  408.              ;; system inheirits lcl
  409.              (system::run-program "cc" :arguments args)
  410.                (declare (ignore iostream estream pid))
  411.                exitstatus)
  412.              #+(or kcl ibcl)
  413.              (system (format nil "cc~{ ~A~}" args)))
  414.            (error "Compile of ~A failed." src)))))
  415.  
  416.       ;; Now compile and load all the files.
  417.       ;; Defer compiler warnings until everything's compiled, if possible.
  418.       (#+clx-ansi-common-lisp with-compilation-unit
  419.        #+lcl3.0 lucid::with-deferred-warnings
  420.        #-(or lcl3.0 clx-ansi-common-lisp) progn
  421.        ()
  422.        
  423.        (compile-and-load "package")
  424.        #+akcl (compile-and-load "kcl-patches")
  425.        #+(or lucid kcl ibcl) (when compile-c (compile-c "socket"))
  426.        #+(or kcl ibcl) (compile-lisp "sockcl")
  427.        #+(or lucid kcl ibcl) (clx-foreign-files binary-path)
  428.        #+excl (compile-and-load "excldep")
  429.        (compile-and-load "depdefs")
  430.        (compile-and-load "clx")
  431.        (compile-and-load "dependent")
  432.        #+excl (compile-and-load "exclcmac")    ; these are just macros
  433.        (compile-and-load "macros")        ; these are just macros
  434.        (compile-and-load "bufmac")        ; these are just macros
  435.        (compile-and-load "buffer")
  436.        (compile-and-load "display")
  437.        (compile-and-load "gcontext")
  438.        (compile-and-load "input")
  439.        (compile-and-load "requests")
  440.        (compile-and-load "fonts")
  441.        (compile-and-load "graphics")
  442.        (compile-and-load "text")
  443.        (compile-and-load "attributes")
  444.        (compile-and-load "translate")
  445.        (compile-and-load "keysyms")
  446.        (compile-and-load "manager")
  447.        (compile-and-load "image")
  448.        (compile-and-load "resource")
  449.        (compile-and-load "describe")
  450.        (compile-and-load "trace")
  451.        ))))
  452.  
  453.  
  454. ;;;; Load CLX
  455.  
  456. ;;; This procedure loads the binaries for CLX.  All of the binaries
  457. ;;; should be in the same directory, so setting the default pathname
  458. ;;; should point load to the right place.
  459.  
  460. ;;; You should have a module definition somewhere so the require/provide
  461. ;;; mechanism can avoid reloading CLX.  In an ideal world, somebody would
  462. ;;; just put
  463. ;;;        (REQUIRE 'CLX)
  464. ;;; in their file (some implementations don't have a central registry for
  465. ;;; modules, so a pathname needs to be supplied).
  466.  
  467. ;;; The REQUIRE should find a file that does
  468. ;;;        (IN-PACKAGE 'XLIB :USE '(LISP))
  469. ;;;        (PROVIDE 'CLX)
  470. ;;;        (LOAD <clx-defsystem-file>)
  471. ;;;        (LOAD-CLX <binary-specific-clx-directory>)
  472.  
  473. #-(or lispm allegro)
  474. (defun load-clx (&optional (binary-pathname-defaults "")
  475.          &key (macrosp nil))
  476.  
  477.   (let* ((source-path (pathname ""))
  478.      (path        (make-pathname
  479.             :host      (pathname-host      source-path)
  480.             :device    (pathname-device    source-path)
  481.             :directory (pathname-directory source-path)
  482.             :name      (pathname-name      source-path)
  483.             :type      nil
  484.             :version   (pathname-version   source-path)))
  485.      (binary-path (merge-pathnames binary-pathname-defaults
  486.                        path))
  487.      (*load-verbose* t))
  488.  
  489.     (flet ((load-binary (filename)
  490.          (let ((binary (merge-pathnames filename binary-path)))
  491.            (load binary))))
  492.  
  493.       (load-binary "package")
  494.       #+akcl (load-binary "kcl-patches")
  495.       #+(or lucid kcl ibcl) (clx-foreign-files binary-path)
  496.       #+excl (load-binary "excldep")
  497.       (load-binary "depdefs")
  498.       (load-binary "clx")
  499.       (load-binary "dependent")
  500.       (when macrosp
  501.     #+excl (load-binary "exclcmac")
  502.     (load-binary "macros")
  503.     (load-binary "bufmac"))
  504.       (load-binary "buffer")
  505.       (load-binary "display")
  506.       (load-binary "gcontext")
  507.       (load-binary "input")
  508.       (load-binary "requests")
  509.       (load-binary "fonts")
  510.       (load-binary "graphics")
  511.       (load-binary "text")
  512.       (load-binary "attributes")
  513.       (load-binary "translate")
  514.       (load-binary "keysyms")
  515.       (load-binary "manager")
  516.       (load-binary "image")
  517.       (load-binary "resource")
  518.       (load-binary "describe")
  519.       (load-binary "trace")
  520.       )))
  521.